home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / uim / ichar.scm < prev    next >
Encoding:
Text File  |  2010-11-07  |  4.0 KB  |  166 lines
  1. ;;; ichar.scm: Integer-based character processing (being obsoleted)
  2. ;;;
  3. ;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/
  4. ;;;
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Redistribution and use in source and binary forms, with or without
  8. ;;; modification, are permitted provided that the following conditions
  9. ;;; are met:
  10. ;;; 1. Redistributions of source code must retain the above copyright
  11. ;;;    notice, this list of conditions and the following disclaimer.
  12. ;;; 2. Redistributions in binary form must reproduce the above copyright
  13. ;;;    notice, this list of conditions and the following disclaimer in the
  14. ;;;    documentation and/or other materials provided with the distribution.
  15. ;;; 3. Neither the name of authors nor the names of its contributors
  16. ;;;    may be used to endorse or promote products derived from this software
  17. ;;;    without specific prior written permission.
  18. ;;;
  19. ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
  20. ;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  21. ;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  22. ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
  23. ;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  24. ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  25. ;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  26. ;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  27. ;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  28. ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  29. ;;; SUCH DAMAGE.
  30.  
  31. (require-extension (srfi 60))
  32.  
  33.  
  34. ;;
  35. ;; Converters
  36. ;;
  37.  
  38. ;; TODO: write test
  39. (define string->ichar
  40.   (lambda (str)
  41.     (and (= (string-length str)
  42.         1)
  43.      (string->charcode str))))
  44.  
  45. ;; TODO: write test
  46. (define string->printable-ichar
  47.   (lambda (str)
  48.     (let ((c (string->ichar str)))
  49.       (and (ichar-printable? c)
  50.        c))))
  51.  
  52. (define string->alphabetic-ichar
  53.   (lambda (str)
  54.     (let ((c (string->printable-ichar str)))
  55.       (and (ichar-alphabetic? c)
  56.        c))))
  57.  
  58. (define numeric-ichar->integer
  59.   (lambda (c)
  60.     (if (ichar-numeric? c)
  61.     (- c 48)
  62.     c)))
  63.  
  64. (define ucs->utf8-string
  65.   (lambda (ucs)
  66.     (with-char-codec "UTF-8"
  67.       (lambda ()
  68.     (let ((str (list->string (list (integer->char ucs)))))
  69.       (with-char-codec "ISO-8859-1"
  70.         (lambda ()
  71.           (%%string-reconstruct! str))))))))
  72.  
  73. ;;
  74. ;; R5RS-like character procedures
  75. ;;
  76.  
  77. (define ichar-control?
  78.   (lambda (c)
  79.     (and (integer? c)
  80.      (or (<= c 31)
  81.          (= c 127)))))
  82.  
  83. (define ichar-upper-case?
  84.   (lambda (c)
  85.     (and (integer? c)
  86.      (>= c 65)
  87.      (<= c 90))))
  88.  
  89. (define ichar-lower-case?
  90.   (lambda (c)
  91.     (and (integer? c)
  92.      (>= c 97)
  93.      (<= c 122))))
  94.  
  95. (define ichar-alphabetic?
  96.   (lambda (c)
  97.     (or (ichar-upper-case? c)
  98.     (ichar-lower-case? c))))
  99.  
  100. (define ichar-numeric?
  101.   (lambda (c)
  102.     (and (integer? c)
  103.      (>= c 48)
  104.      (<= c 57))))
  105.  
  106. (define ichar-printable?
  107.   (lambda (c)
  108.     (and (integer? c)
  109.      (<= c 127)
  110.      (not (ichar-control? c)))))
  111.  
  112. (define ichar-graphic?
  113.   (lambda (c)
  114.     (and (ichar-printable? c)
  115.      (not (= c 32)))))
  116.  
  117. ;; TODO: write test
  118. (define ichar-vowel?
  119.   (let ((vowel-chars (map char->integer
  120.               '(#\a #\i #\u #\e #\o))))
  121.     (lambda (c)
  122.       (and (ichar-alphabetic? c)
  123.        (member (ichar-downcase c)
  124.            vowel-chars)))))
  125.  
  126. ;; TODO: write test
  127. (define ichar-consonant?
  128.   (lambda (c)
  129.     (and (ichar-alphabetic? c)
  130.      (not (ichar-vowel? c)))))
  131.  
  132. (define ichar-downcase
  133.   (lambda (c)
  134.     (if (ichar-upper-case? c)
  135.     (+ c 32)
  136.     c)))
  137.  
  138. (define ichar-upcase
  139.   (lambda (c)
  140.     (if (ichar-lower-case? c)
  141.     (- c 32)
  142.     c)))
  143.  
  144. ;;
  145. ;; backward compatibility
  146. ;;
  147.  
  148. (define charcode->string
  149.   (lambda (c)
  150.     (if (and (integer? c)
  151.          (not (zero? c)))
  152.     (list->string (list (integer->char (bitwise-and 255 c))))
  153.     "")))
  154.  
  155. (define string->charcode
  156.   (lambda (s)
  157.     (let ((sl (with-char-codec "ISO-8859-1"
  158.             (lambda ()
  159.           (string->list s)))))
  160.       (if (null? sl)
  161.       0
  162.       (char->integer (car sl))))))
  163.  
  164. ;; FIXME: write test.
  165. (define ucs-to-utf8-string ucs->utf8-string)
  166.